library(tm) # przetwarzanie tekstu
## Ładowanie wymaganego pakietu: NLP
library(SnowballC) # stemming słów
library(Matrix) # macierze rzadkie
library(dplyr) # manipulacja danymi
##
## Dołączanie pakietu: 'dplyr'
## Następujące obiekty zostały zakryte z 'package:stats':
##
## filter, lag
## Następujące obiekty zostały zakryte z 'package:base':
##
## intersect, setdiff, setequal, union
library(ClusterR) # klasteryzacja
library(plotly) # wizualizacja
## Ładowanie wymaganego pakietu: ggplot2
##
## Dołączanie pakietu: 'ggplot2'
## Następujący obiekt został zakryty z 'package:NLP':
##
## annotate
##
## Dołączanie pakietu: 'plotly'
## Następujący obiekt został zakryty z 'package:ggplot2':
##
## last_plot
## Następujący obiekt został zakryty z 'package:stats':
##
## filter
## Następujący obiekt został zakryty z 'package:graphics':
##
## layout
data <- read.csv('wikipedia.csv', row.names = "X") # wczytanie pliku CSV z danymi
#head(data) # podgląd pierwszych wierszy
#str(data) # struktura danych
#colnames(data) # nazwy kolumn
#dim(data) # wymiary danych
#head(data$summary)
set.seed(123)
x <- sample(nrow(data), 6000) # losowa próbka 6000 wierszy, niestety redukacja było potrzebna z powodu niewystarczającej ilości RAM
data <- data[x, ]
nrow(data) # sprawdzenie liczby obserwacji
## [1] 6000
corpus <- VCorpus(VectorSource(data$summary)) %>%
tm_map(content_transformer(tolower)) %>% # małe litery
tm_map(removeNumbers) %>% # usunięcie cyfr
tm_map(removePunctuation) %>% # usunięcie interpunkcji
tm_map(removeWords, stopwords()) %>% # usunięcie stopwords
tm_map(content_transformer(function(x){
x <- gsub('\n', ' ', x) # usunięcie znaków nowej linii
x <- gsub('\\n', ' ', x)
x
})) %>%
tm_map(stemDocument) %>% # stemming
tm_map(stripWhitespace) # usunięcie nadmiarowych spacji
dtm <- DocumentTermMatrix(corpus) # macierz dokument-słowo
rm(corpus) # zwalnianie pamięci
dtm_sparse <- sparseMatrix(
i = dtm$i,
j = dtm$j,
x = as.numeric(dtm$v > 0),
dims = c(dtm$nrow, dtm$ncol),
dimnames = dimnames(dtm)
)
rm(dtm)
word_count <- colSums(dtm_sparse)
freq_words <- names(word_count[word_count >= 5])
dtm_sparse <- dtm_sparse[, freq_words]
corpus_title <- VCorpus(VectorSource(data$title)) %>%
tm_map(stemDocument) %>%
tm_map(stripWhitespace)
dtm_title <- DocumentTermMatrix(corpus_title)
rm(corpus_title)
dtm_title_sparse <- sparseMatrix(
i = dtm_title$i,
j = dtm_title$j,
x = as.numeric(dtm_title$v > 0),
dims = c(dtm_title$nrow, dtm_title$ncol),
dimnames = dimnames(dtm_title)
)
rm(dtm_title)
colnames(dtm_title_sparse) <- paste("title", colnames(dtm_title_sparse), sep='_')
dtm_combined <- cbind(dtm_sparse, dtm_title_sparse)
rm(dtm_sparse, dtm_title_sparse)
# na początekwybierzemy taką liczbę klastrów, gdyż tyle mamy naturalnie kategorii w danych
k <- 6
set.seed(123)
km_result <- kmeans(dtm_combined, centers = k)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
km_result$size # liczność klastrów
## [1] 918 797 389 128 3437 331
km_result$tot.withinss # suma wariancji wewnątrzklastrowych
## [1] 1152820
wiki_stopwords <- c(
"state","found","call","end","mani","world","continu",
"howev","make","given","known","name","term","often",
"common","gener","well","later","earli",
"can","may","two","three","first","second","one",
"differ","relat","follow","form","case",
"refer","also","see","use","includ","exampl","general",
"therefor","thus",
"publish","public","book","studi","work","author",
"research","paper","journal"
)
dtm_filtered <- dtm_combined[, !colnames(dtm_combined) %in% wiki_stopwords]
km_result_filtered <- kmeans(dtm_filtered, centers = k)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
km_result_filtered$size
## [1] 111 3553 361 893 314 768
km_result_filtered$tot.withinss
## [1] 1110474
wcss_1 <- km_result_filtered$tot.withinss
# tutaj spróbujemy puścić klasteryzację dla innych wartości parametru k 2,3,4,5, 7, 8, 9
km_2 <- kmeans(dtm_filtered, centers = 2)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
wcss_2 <- km_2$tot.withinss
set.seed(123)
km_3 <- kmeans(dtm_filtered, centers = 3)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
wcss_3 <- km_3$tot.withinss
set.seed(123)
km_4 <- kmeans(dtm_filtered, centers = 4)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
wcss_4 <- km_4$tot.withinss
set.seed(123)
km_5 <- kmeans(dtm_filtered, centers = 5)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
wcss_5 <- km_5$tot.withinss
# dla lepszego efektu spróbujemy puścić jeszcze dla k = 7, 8, 9 jeżeli się uda
set.seed(123)
km_7 <- kmeans(dtm_filtered, centers = 7)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
wcss_7 <- km_7$tot.withinss
set.seed(123)
km_8 <- kmeans(dtm_filtered, centers = 8)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
## Warning: 'medpolish()' nie zbiegł się w 10 iteracjach
wcss_8 <- km_8$tot.withinss
set.seed(123)
km_9 <- kmeans(dtm_filtered, centers = 9)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
## Warning in asMethod(object): 'medpolish()' nie zbiegł się w 10 iteracjach
wcss_9 <- km_9$tot.withinss
# wykres homogeniczność wewnątrz klastrów, na jego podstawie spróbujemy znaleźć punkt łokcia i dobrać odpowiednią liczbę klastrów
results_manual <- data.frame(
k = c(2, 3, 4, 5, 6, 7, 8, 9),
WCSS = c(wcss_2, wcss_3, wcss_4, wcss_5, wcss_1, wcss_7, wcss_8, wcss_9)
)
results_manual
## k WCSS
## 1 2 1167102
## 2 3 1140548
## 3 4 1126545
## 4 5 1117117
## 5 6 1110474
## 6 7 1105696
## 7 8 1102046
## 8 9 1097683
p_wcss <- plot_ly(
results_manual,
x = ~k,
y = ~WCSS,
type = "scatter",
mode = "lines+markers"
) %>%
layout(
title = "Elbow method – homogeniczność (WCSS)",
xaxis = list(title = "Liczba klastrów (k)"),
yaxis = list(title = "WCSS"),
margin = list(
l = 80, # left
r = 40, # right
b = 80, # bottom
t = 80 # top
)
)
p_wcss
# z wykresu możemy zauważyć, że najmniejsza wartość, począwszy od której mamy minimalna zmniejszanie wartości to k = 5 lub 4 i tym wartością się też się przyjżymy
# analiza dla k = 4
km_4$size
## [1] 810 4246 699 245
km_4$centers[, 1:10]
## − –cite –present ——— ’ve ···
## 1 0.007407407 0.0024691358 0.002469136 0.0000000000 0.000000000 0.0061728395
## 2 0.000000000 0.0009420631 0.004003768 0.0007065473 0.000000000 0.0002355158
## 3 0.000000000 0.0000000000 0.028612303 0.0028612303 0.004291845 0.0000000000
## 4 0.000000000 0.0000000000 0.036734694 0.0000000000 0.008163265 0.0000000000
## aaa aaaldot aab aacdot
## 1 0.008641975 0.008641975 0.0024691358 0.009876543
## 2 0.002826189 0.000000000 0.0007065473 0.000000000
## 3 0.008583691 0.000000000 0.0000000000 0.000000000
## 4 0.008163265 0.000000000 0.0000000000 0.000000000
# coś co być może pomoże nam zobaczyć jakie słowa są charakterystyczne dla danych klastrów
get_top_words_contrastive <- function(dtm, km, cluster_id, top_n = 10) {
in_cluster <- km$cluster == cluster_id
out_cluster <- km$cluster != cluster_id
mu_in <- colMeans(dtm[in_cluster, , drop = FALSE])
mu_out <- colMeans(dtm[out_cluster, , drop = FALSE])
score <- mu_in - mu_out
score <- sort(score, decreasing = TRUE)
head(score, top_n)
}
for (k in 1:4) {
cat("\n====================\n")
cat("CLUSTER", k, "\n")
print(get_top_words_contrastive(dtm_filtered, km_4, k, 10))
}
##
## ====================
## CLUSTER 1
## displaystyl result defin valu function consid
## 0.6095625 0.5551060 0.5549632 0.5455506 0.5289231 0.5077428
## set possibl requir mean
## 0.4933205 0.4924570 0.4881610 0.4840505
##
## ====================
## CLUSTER 2
## title_list phd postdoctor peerreview title_physic
## 0.028065049 0.017462005 0.011566054 0.011367866 0.010412913
## title_prize title_societi title_for sloan editorinchief
## 0.008850506 0.008652318 0.008603442 0.007958661 0.007562285
##
## ====================
## CLUSTER 3
## year new histori time part peopl centuri made
## 0.5445883 0.5032138 0.4784991 0.4716164 0.4415217 0.4381828 0.4366121 0.4282349
## nation cultur
## 0.4198228 0.3896819
##
## ====================
## CLUSTER 4
## led place major peopl much caus great even
## 0.7598362 0.7585844 0.7583468 0.7508715 0.7452189 0.7345520 0.7330768 0.7297434
## remain sever
## 0.7276760 0.7259916
# to co otrzymaliśmy jest dosyć charakterystyczne dla klastrów chociażby dla klastra 2 słoa sugerują raczej na tematykę matematyczną, funkcja, consider, define, depend i tak dalej dla klastra 3 mamy coś co sugerowałoby na histoię matematyki i fizyki jakiś wielkich umysłów, a słowa dla klastra numer 4 sugerują tematykę historyczną
# anlogicznie przeanalizujemy dla k = 5
for (k in 1:5) {
cat("\n====================\n")
cat("CLUSTER", k, "\n")
print(get_top_words_contrastive(dtm_filtered, km_5, k, 10))
}
##
## ====================
## CLUSTER 1
## displaystyl defin function result valu set
## 0.5533400 0.4156151 0.3837161 0.3556313 0.3518177 0.3503904
## number equat frac properti
## 0.3189163 0.3138446 0.3136912 0.3083487
##
## ====================
## CLUSTER 2
## year new histori time peopl part centuri made
## 0.5456224 0.5005224 0.4839423 0.4710577 0.4594601 0.4378231 0.4356537 0.4353525
## nation cultur
## 0.4306067 0.4031504
##
## ====================
## CLUSTER 3
## result requir possibl similar depend show consid way
## 0.6504459 0.6354167 0.6290346 0.6139869 0.6118749 0.6093837 0.6074323 0.6056629
## mean anoth
## 0.6024759 0.6021247
##
## ====================
## CLUSTER 4
## peopl led major place began great caus claim
## 0.7842100 0.7779170 0.7661904 0.7598602 0.7573243 0.7561468 0.7533815 0.7462438
## day came
## 0.7450469 0.7384147
##
## ====================
## CLUSTER 5
## phd title_list peerreview postdoctor award
## 0.032551679 0.027699608 0.015454077 0.013882574 0.012194876
## title_physic title_societi title_prize editorinchief homepag
## 0.010281032 0.010149473 0.010018394 0.009429981 0.008775308
# możemy zauważyć, że słownictwo dla klastra 1 jest dosyć typowo naukowe dla nauk ściłśych jak fizyka czy matematyka
# klaster 2 charakteryzuje się słownictwem tytułów nauków więc może coś o dziennikach oraz biografii matematyków, fizyków ich historia
# w klastrze 3 mamy typowe słownictwo dla historii społeczeństwa i kultury, przywództwa
# klaster 4 słownictwo typowo matematyczne
# klaster 5 być może dotyczy opisów historycznych, społecznyc i geogradficznych
# co w miarę pokrywa się z naszymi kategoriami